(FILECREATED " 7-NOV-73  5:23:48" S-DRAW)


  (LISPXPRINT (QUOTE DRAWVARS)
              T)
  [RPAQQ DRAWVARS
         ((* All I/O routines have been moved here)
          (FNS DRAW PRINN DRAWS GENLET PRINRAD NUMNODES PRINRAD1 
               PRINCTAB PRINRAD0 PRINENTRY PRINRADOFF)
          (VARS STRUCNUM (DRAWFORK)
                GFILE)
          (USERMACROS DL DRAWS DRAW)
          (ADVICE (SUBSYS IN DRAW]

(* All I/O routines have been moved here)

(DEFINEQ

(DRAW
  [LAMBDA (STRUC)
    (PROG (O CTAB)
          [SETQ O (OUTPUT (OUTFILE (QUOTE FOR01.DAT;T]
          [RESETFORM (OUTPUT O)
                     (PROG NIL
                       LP  (COND
                             ((NULL STRUC)
                               (RETURN))
                             ((STRUCLIST? STRUC)
                               (SETQ STRUC (CDDR STRUC))
                               (GO LP))
                             ((STRUCTURE? STRUC)
                               (DRAWS STRUC))
                             ((RADICAL? STRUC)
                               (PRINRAD STRUC))
                             ((STRUCTURE? (CAR STRUC))
                               (DRAWS (CAR STRUC)
                                      NIL)
                               (SETQ STRUC (CDR STRUC))
                               (GO LP))
                             ((RADICAL? (CAR STRUC))
                               (PRINRAD (CAR STRUC))
                               (SETQ STRUC (CDR STRUC))
                               (GO LP))
                             (T (CLOSEF O)
                                (ERROR!]
          (CLOSEF O)
          (OR [CAR (NLSETQ (AND DRAWFORK (SUBSYS DRAWFORK NIL NIL
                                                 (QUOTE START]
              (SETQ DRAWFORK (SUBSYS (QUOTE DRAW])

(PRINN
  [LAMBDA (N L)
    (SPACES (IDIFFERENCE L (NCHARS N)))
    (PRIN1 N])

(DRAWS
  [LAMBDA (STRUC ID)
    (PROG (CTAB)
          (SETQ XLATETAB NIL)
          (SETQ CTAB (FETCH CTABLE OF STRUC))
          (PRINN (LENGTH CTAB)
                 5)
          (TERPRI)
          [MAPC CTAB (FUNCTION (LAMBDA (CTE)
                    (PRINENTRY (FETCH NODENUM OF CTE)
                               (FETCH ATOMTYPE OF
                                      (FETCH MARKERS OF CTE))
                               (FETCH NBRS OF CTE]
          (PRIN1 " ")
          (PRINT (OR ID (FETCH UGRAPH OF STRUC)))
          [COND
            (XLATETAB (FOR PR IN XLATETAB DO (SPACES 1)
                                             (PRIN1 (CAR PR))
                                             (PRIN1 " = ")
                                             (PRINT (CDR PR]
          (PRINT (QUOTE END*])

(GENLET
  [LAMBDA (AT)
    (OR (FOR PR IN XLATETAB ISSOME (AND (EQUAL AT (CDR PR))
                                        (CAR PR)))
        (CAAR (SETQ XLATETAB
                (CONS (CONS (FOR LET
                               IN (QUOTE (X Y Z W # & ← ≠
                                            ! , ? V U T R Q P M L K J 
                                            I G F E D B A N O C H))
                               SUCHTHAT (NOT (ASSOC LET XLATETAB)))
                            AT)
                      XLATETAB])

(PRINRAD
  [LAMBDA (L XLATETAB TITLE)
    (PROG (N)
          (SETQ N (NUMNODES L))
          (PRINN N 5)
          (TERPRI)
          (PRINRAD1 NIL (FOR I TO N COLLECT I)
                    L)
          (PRINRADOFF])

(NUMNODES
  [LAMBDA (RAD)
    (IPLUS [FOR R IN (FETCH ATTACHEDRADS OF RAD)
              SUM (ITIMES (CDR R)
                          (NUMNODES (CAR R]
           (COND
             ((NULL (FETCH CENTER OF RAD))
               0)
             ((ATOM (FETCH CENTER OF RAD))
               1)
             ([NOT (STRUCTURE? (FETCH RADSTRUC OF
                                      (FETCH CENTER OF RAD]
               1)
             (T (LENGTH (NODES (FETCH RADSTRUC OF
                                      (FETCH CENTER OF RAD])

(PRINRAD1
  [LAMBDA (EFF AA RAD)
    (PROG (CENT ATTACHED J X TTABLE)
          (SETQ CENT (FETCH CENTER OF RAD))
          (SETQ ATTACHED (CLEXPAND (FETCH ATTACHEDRADS OF RAD)))
          (RETURN (COND
                    ((NOT CENT)
                      (PRINRAD1 (CADR AA)
                                (CONS (CAR AA)
                                      (PRINRAD1 (CAR AA)
                                                (CDR AA)
                                                (CAR ATTACHED)))
                                (CADR ATTACHED)))
                    ([OR (ATOM CENT)
                         (NOT (STRUCTURE? (FETCH RADSTRUC OF CENT]
                      (SETQ X (CDR AA))
                      (FOR R IN ATTACHED
                         DO (SETQ J (CONS (CAR X)
                                          J))
                            (SETQ X (PRINRAD1 (CAR AA)
                                              X R)))
                      (PRINENTRY (CAR AA)
                                 CENT
                                 (COND
                                   (EFF (CONS EFF J))
                                   (T J)))
                      X)
                    (T [SETQ X
                         (COND
                           ((NOT EFF)
                             AA)
                           (T (SETQ TTABLE
                                (LIST (LIST (FETCH AFFLINK OF CENT)
                                            (CAR AA)
                                            EFF)))
                              (CDR AA]
                       (FOR N IN (NODES (FETCH RADSTRUC OF CENT))
                          WHEN (NOT (EQUAL N (FETCH AFFLINK OF CENT)))
                          DO (SETQ TTABLE (CONS (LIST N (CAR X))
                                                TTABLE))
                             (SETQ X (CDR X)))
                       (FOR NLIST IN (FETCH CUFFLINKS OF CENT)
                                    FOR C
                          IN NLIST
                          AS CT IS (LMASSOC C TTABLE NIL)
                          DO (NCONC1 CT (CAR X))
                             (SETQ X (PRINRAD1 (CAR CT)
                                               X
                                               (CAR ATTACHED)))
                             (SETQ ATTACHED (CDR ATTACHED)))
                       (PRINCTAB (FETCH CTABLE OF
                                        (FETCH RADSTRUC OF CENT))
                                 TTABLE)
                       X])

(PRINCTAB
  [LAMBDA (CTAB TTABLE)
    (FOR CT IN CTAB AS CPRIME IS (LMASSOC (FETCH NODENUM OF CT)
                                          TTABLE NIL)
       DO (PRINENTRY (CAR CPRIME)
                     (FETCH ATOMTYPE OF (FETCH MARKERS OF CT))
                     (APPEND (CDR CPRIME)
                             (FOR Y IN (FETCH NBRS OF CT)
                                WHEN (NOT (EQ Y (QUOTE FV)))
                                     XLIST
                                     (CAR (LMASSOC Y TTABLE NIL])

(PRINRAD0
  [LAMBDA (L)
    (PRINN L 3])

(PRINENTRY
  [LAMBDA (N AT CON)
    (PRINN N 3)
    (PRIN1 " ")
    [PRIN1 (COND
             ((EQ 1 (NCHARS AT))
               AT)
             ((NOT AT)
               (FOR X IN CON WHEN (EQ X (QUOTE FV)) SUM 1))
             (T (GENLET AT]
    (TAB 6)
    [MAPC CON (FUNCTION (LAMBDA (X)
              (OR (EQ X (QUOTE FV))
                  (PRINN X 3]
    (TERPRI])

(PRINRADOFF
  [LAMBDA (L)
    (TERPRI)
    (AND TITLE (PRINT TITLE))
    [COND
      (XLATETAB (FOR PR IN XLATETAB DO (SPACES 1)
                                       (PRIN1 (CAR PR))
                                       (PRIN1 " = ")
                                       (PRINT (CDR PR]
    (PRINT (QUOTE END*])
)
  (RPAQQ STRUCNUM 1)
  (RPAQ DRAWFORK)
  (RPAQQ GFILE T)
  (ADDTOVAR USERMACROS (DRAW X (E (DRAW (## . X))
                                  T))
            (DRAW NIL (DRAW)))
  (ADDTOVAR EDITCOMSA DRAW)
  (ADDTOVAR EDITCOMSL DRAW)
(DEFLIST(QUOTE(
  [SUBSYS-IN-DRAW ((DRAW . SUBSYS)
                   (AFTER NIL (RETURN (KFORK !VALUE]
))(QUOTE READVICE))

STOP